home *** CD-ROM | disk | FTP | other *** search
- PAGE 66,132
- ;
- ; Utility subroutines for use with MS-FORTRAN
- ;
- ; by Mark Dahmke
- ; May, 1986
- ;
- PUBLIC SRCHF, SRCHN, CHDIR, GETDIR, GETDFS
- ;
- SUBTTL 'MACROS'
- PAGE
- ;
- ;------ MACROS ------
- ;
- DOS MACRO
- INT 21H ;REQUEST DOS SERVICE
- ENDM
- ;
- ;---------------------------------------------------------------
- ; SETFRAME: Sets the environment upon entry to a subroutine.
- ;
- SETFRAME MACRO
- PUSH BP ;SAVE FRAMEPOINTER ON STACK
- MOV BP,SP
- ENDM
- ;
- ; POPRET: Restores the BP register and returns to the
- ; calling FORTRAN routine after cleaning up the
- ; stack.
- ;
- POPRET MACRO NPARMS ;RETURN FROM SUBR. NPARMS=NUMBER OF PARMS
- POP BP
- RET NPARMS*4
- ENDM
- ;
- ; GETPARM: returns a pointer to a parameter in the call list.
- ;
- ; Operands: X = the number of the desired parameter
- ; MAX = the maximum number of parameters in
- ; the call list.
- ;
- ; Result: The ES:BX register pair points to the parameter.
- ;
- GETPARM MACRO X,MAX ;PARAMETER NUMBER (IE, 1,2,3)
- LES BX,DWORD PTR SS:[BP+(MAX-X)*4+6]
- ENDM
- ;
- ;
- ;--------------------------------------------------------------
- ;
- SUBTTL 'DATA SEGMENT'
- PAGE
- ;-------------------------------
- DATA SEGMENT PUBLIC 'DATA'
- ;
- SDMA DB 128 DUP(0) ;DMA BUFFER FOR SRCHF AND SRCHN ROUTINES
- ;
- FCB DB 0
- DB 8 DUP(0) ;FILE NAME (1-8)
- DB 0,0,0 ;FILE TYPE (9-11)
- DW 0 ;CURRENT BLOCK (12-13)
- DW 0 ;LOGICAL RECORD SIZE (14-15)
- DW 0,0 ;FILE SIZE (16-19)
- DW 0 ;DATE (20-21)
- DW 0,0,0,0,0 ;RESERVED (22-31)
- DB 0 ;CURRENT RELATIVE RECORD
- DW 0,0 ;RELATIVE RECORD NUMBER
- DB 0
- DB 0
- ;
- IDRIVE DW 0
- STRING DW 0
- STRING_SEG DW 0
- ;
- DATA ENDS
- DGROUP GROUP DATA
- ;
- SUBTTL 'CODE SEGMENT'
- PAGE
- ;
- CODE SEGMENT 'CODE'
- ASSUME CS:CODE, DS:DGROUP, SS:DGROUP
- ;
- ;-------------------------------
- ;SEARCH FOR FIRST DIRECTORY ENTRY
- ;
- ; PARM LIST: CALL SRCHF(IDRV,FSPEC,RFNAME)
- ;
- ; INPUT: IDRV, FSPEC -- 0=CURRENT, 1=A, 2=B, FSPEC= ????????.???
- ; OUTPUT: RFNAME -- FILENAME.TYP
- ;
- SRCHF PROC FAR ;SEARCH FOR FIRST DIR ENTRY
- SETFRAME
- ;
- GETPARM 1,3 ;GET DRIVE CODE ADDR
- MOV AX,ES:[BX] ;GET VALUE
- MOV IDRIVE,AX
- MOV FCB,AL ;SET UP FCB
- ;
- GETPARM 2,3 ;GET FILESPEC
- ;
- MOV STRING,BX
- MOV STRING_SEG,ES ;SAVE PTR AND SEG
- ;
- MOV DI,OFFSET DGROUP:FCB+1
- PUSH DS ;SAVE DS
- PUSH DS
- POP ES ;SET UP DEST
- MOV SI,STRING
- MOV DS,STRING_SEG
- MOV CX,11
- REP MOVSB ;COPY FILESPEC 11 CHARS
- ;
- POP DS ;RESTORE DS
- MOV DX,OFFSET DGROUP:SDMA
- MOV AH,1AH
- DOS ;SET DMA ADDRESS
- ;
- MOV DX,OFFSET DGROUP:FCB
- MOV AH,11H ;SEARCH-FIRST BDOS COMMAND
- DOS
- ;
- CMP AL,0FFH
- JZ NO_FILES ;IF NO FILES, SKIP OUT.
- ;
- GETPARM 3,3 ;GET RETURN FILENAME ADDR IN ES:BX
- MOV DI,BX ;SET UP ES:DI POINTER FOR MOVE
- MOV SI,OFFSET DGROUP:SDMA+1 ;POINT TO FILE NAME
- PUSH DS
- POP ES ;SET UP DEST SEG
- MOV CX,11 ;MOVE 11 BYTES
- REP MOVSB
- ;
- JMP S_DONE
- ;
- ;
- NO_FILES: ;IF NO FILES ARE PRESENT,
- GETPARM 3,3
- MOV BYTE PTR ES:[BX],'?' ;PUT A ? IN FIRST CHAR
- ;OF OUTPUT FILE NAME
- S_DONE: POPRET 3
- SRCHF ENDP
- ;
- ;-------------------------------
- ;SEARCH FOR NEXT DIRECTORY ENTRY
- ;
- ; PARM LIST: CALL SRCHN(IDRV,FSPEC,RFNAME)
- ;
- ; INPUT: IDRV, FSPEC -- 0=CURRENT, 1=A, 2=B, FSPEC= ????????.???
- ; OUTPUT: RFNAME -- FILENAME.TYP
- ;
- SRCHN PROC FAR ;SEARCH FOR NEXT DIR ENTRY
- SETFRAME
- ;
- GETPARM 1,3 ;GET DRIVE CODE ADDR
- MOV AX,ES:[BX] ;GET VALUE
- MOV IDRIVE,AX
- MOV FCB,AL ;SET UP FCB
- ;
- GETPARM 2,3 ;GET FILESPEC
- ;
- MOV STRING,BX
- MOV STRING_SEG,ES ;SAVE PTR AND SEG
- ;
- PUSH DS ;SAVE SEG
- PUSH DS
- POP ES
- MOV DI,OFFSET DGROUP:FCB+1
- MOV SI,STRING
- MOV DS,STRING_SEG
- MOV CX,11
- REP MOVSB ;COPY FILESPEC 11 CHARS
- ;
- POP DS
- MOV DX,OFFSET DGROUP:SDMA
- MOV AH,1AH
- DOS ;SET DMA ADDRESS
- ;
- MOV DX,OFFSET DGROUP:FCB
- MOV AH,12H ;SEARCH-NEXT BDOS COMMAND
- DOS
- ;
- CMP AL,0FFH
- JZ NNO_FILES ;IF NO FILES, SKIP OUT.
- ;
- GETPARM 3,3 ;GET RETURN FILENAME ADDR IN ES:BX
- MOV DI,BX ;SET UP ES:DI POINTER FOR MOVE
- MOV SI,OFFSET DGROUP:SDMA+1 ;POINT TO FILE NAME
- MOV CX,11 ;MOVE 11 BYTES
- REP MOVSB
- ;
- JMP N_DONE
- ;
- NNO_FILES: ;IF NO FILES ARE PRESENT,
- GETPARM 3,3
- MOV BYTE PTR ES:[BX],'?' ;PUT A ? IN FIRST CHAR OF OUTPUT FILE NAME
- ;OUTPUT FILE NAME
- N_DONE: POPRET 3
- SRCHN ENDP
- ;----------------------------------
- ; GETDIR: RETURN ASCII STRING CONTAINING CURRENT DIRECTORY PATH
- ;
- ;
- ; CALL GETDIR(PATH,IDRIVE,ICODE)
- ;
- ; PATH = CHARACTER*64 (RETURNED PATH NAME)
- ; ICODE = INTEGER (RETURN CODE)
- ; IDRIVE= INTEGER (DRIVE, 0=DEFAULT, 1=A, 2=B)
- ;
- ; NOTE: PATH IS RETURNED WITH NO STARTING BACKSLASH
- ; AND WITHOUT THE DRIVE LETTER AND COLON.
- ; THE PATH STRING IS TERMINATED WITH A ZERO BYTE.
- ;
- GETDIR PROC FAR ;GET PATH NAME ON IDRIVE
- ;
- SETFRAME
- ;
- GETPARM 1,3
- MOV STRING,BX ;SAVE PTR TO OUTPUT STRING AREA
- MOV STRING_SEG,ES ;AND SEG
- ;
- GETPARM 2,3 ;GET DRIVE CODE ADDR
- MOV AX,ES:[BX] ;GET VALUE
- MOV IDRIVE,AX ;AND SAVE IT
- ;
- PUSH DS
- MOV SI,STRING ;SET UP PATH STRING POINTER
- ;
- MOV DX,IDRIVE ;GET DRIVE NUMBER
- MOV AX,STRING_SEG
- MOV DS,AX
- ;
- MOV AH,47H ;GET DIRECTORY NAME
- DOS
- ;
- GETPARM 3,3
- MOV AH,0 ;CLEAR OUT AH
- MOV ES:[BX],AX ;STORE IT
- ;
- POP DS
- POPRET 3
- GETDIR ENDP
- ;----------------------------------
- ; CHDIR: SET DIRECTORY PATH TO STRING FOUND IN PATH.
- ;
- ;
- ; CALL CHDIR(PATH,ICODE)
- ;
- ; PATH = CHARACTER*64 (INPUT PATH NAME)
- ; ICODE = INTEGER (RETURN CODE)
- ;
- ; NOTE: PATH MUST CONTAIN THE PATH NAME, TERMINATED BY
- ; A ZERO BYTE. THE DRIVE LETTER AND COLON AND
- ; BACKSLASH MAY BE AT THE START OF THE STRING.
- ;
- CHDIR PROC FAR ;SET PATH NAME
- ;
- SETFRAME
- ;
- GETPARM 1,2
- MOV STRING,BX ;SAVE PTR TO INPUT STRING AREA
- MOV STRING_SEG,ES ;AND SEG
- ;
- PUSH DS ;SAVE DS
- PUSH ES
- POP DS
- MOV DX,BX ;SET UP PATH STRING POINTER
- ;
- MOV AH,3BH ;SET DIRECTORY PATH
- DOS
- ;
- GETPARM 2,2 ;POINT TO ICODE
- MOV AH,0 ;CLEAR OUT AH
- MOV ES:[BX],AX ;STORE IT
- ;
- POP DS ;RESTORE DS
- POPRET 2
- CHDIR ENDP
-
- ;----------------------------------
- ; GETDFS: GET DISK FREE SPACE IN BYTES.
- ;
- ;
- ; CALL GETDFS(IDRIVE,IBYTES,ISECT,ICLUST)
- ;
- ; IDRIVE= INTEGER*2 (DRIVE NUMBER)
- ; IBYTES= INTEGER*2 (NUMBER OF BYTES /SECTOR)
- ; ISECT = INTEGER*2 (NUMBER OF SECTORS / CLUSTER)
- ; ICLUST= INTEGER*2 (NUMBER OF CLUSTERS REMAINING)
- ;
- ; IF ISECT = FFFFh THEN ERROR: INVALID DRIVE CODE
- ;
- GETDFS PROC FAR ;GET SPACE REMAINING
- ;
- SETFRAME
- ;
- GETPARM 1,4
- MOV DX,ES:[BX] ;GET DRIVE NUMBER
- ;
- MOV AH,36H ;SET DIRECTORY PATH
- DOS
- ;
- ; THIS FUNCTION RETURNS: AX=FFFF IF ERROR,
- ; BX = NUMBER OF CLUSTERS AVAILABLE
- ; CX = NUMBER OF BYTES PER SECTOR
- ; AX = NUMBER OF SECTORS PER CLUSTER
- ;
- ; THEREFORE, IBYTES = AX * BX * CX
- ;
- PUSH BX ;PUSH ICLUST
- GETPARM 2,4
- MOV ES:[BX],CX ;SAVE IBYTES
- ;
- GETPARM 3,4 ;SAVE ISECT
- MOV ES:[BX],AX
- ;
- GETPARM 4,4
- POP AX
- MOV ES:[BX],AX ;SAVE ICLUST
- ;
- POPRET 4
- GETDFS ENDP
- ;
- CODE ENDS
- END